﻿/// /////////////////////////////////////////////
// 单元名 : LoginForm
// 作者 : Hawk
// 单元描述 :
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit LoginForm;

interface

uses
{$IFnDEF FPC}
  Windows,
{$ELSE}
  LCLIntf, LCLType, LMessages,
{$ENDIF}
  Messages, SysUtils, Controls, Forms, StdCtrls, unitMsgObj, Buttons, MsgBaseForm, Classes;

type
  TOnLoginSucc = procedure(Sender: TObject) of object;

  TfrmLoginForm = class(TfrmMsgBase)
    LabelMessage: TLabel;
    GroupBoxLogin: TGroupBox;
    btnLogin: TBitBtn;
    eLoginPassword: TEdit;
    eUserName: TEdit;
    cbSecurityLogin: TCheckBox;
    procedure FormResize(Sender: TObject);
    procedure btnLoginClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FChallengeLogin: Bool;
    FCommonPwd: AnsiString;
    FOnLoginSucc: TOnLoginSucc;
    procedure ShowMessage(S: string);
    procedure ReturnPressed(Sender: TObject; var Key: Char);
  protected
    procedure DoProcMsg(msg: TMsg); override;
  public
    { Public declarations }

    procedure FuncStart; override;
    procedure FuncStop; override;
    procedure ShowLoginResponse(r: Longword);

    property OnLoginSucc: TOnLoginSucc read FOnLoginSucc write FOnLoginSucc;
  end;

implementation

uses unitObjPool, unitMisc, unitNetCommon, unitCommonDataStruct, unitCommonIntf, unitAAACommon, unitClassIDDef,
  unitIOCPDataObj, unitSvrMngCommon, unitErrCodeDef;

const
  ID_CLIENTLOGIN: TID_OBJ = (IDDetail: (ObjType: 5; SubType: $55;
    SubID: (IDBuf: ($61, $3B, $F2, $62, $FA, $4C, $0E, $9F, $5B, $93, $3E, $73, $04, $A4))));

{$IFnDEF FPC}
  {$R *.dfm}
{$ELSE}
  {$R *.lfm}
{$ENDIF}

type
  TLoginConfig = class(TSerialObj)
  private
    FLoginUser: string;
    FPassword: string;
    FSecurityLogin: Bool;
    procedure SetLoginUser(const Value: string);
    procedure SetPassword(const Value: string);
    procedure SetSecurityLogin(const Value: Bool);
  protected
    procedure DoClone(Target: TSerialObj); override;
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: Longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;
  public
    class function ClassID: Longword; override;
    procedure Return; override;

    property LoginUser: string read FLoginUser write SetLoginUser;
    property Password: string read FPassword write SetPassword;
    property SecurityLogin: Bool read FSecurityLogin write SetSecurityLogin;
  end;

var
  Done: integer;

procedure CB(prg: integer); stdcall;
begin
  DbgPrint('CallBack! %d %d', [prg, Done]);
end;

{ TfrmLoginForm }

procedure TfrmLoginForm.btnLoginClick(Sender: TObject);
var
  lo: TLoginObj;
begin
  if Trim(eUserName.Text) = '' then
  begin
    ShowErrorMsg('请输入账户名', []);
    eUserName.SetFocus;
    Exit;
  end;
  lo := ObjPool.GetObj(TLoginObj, Self);
  if lo <> nil then
  begin
    lo.UserName := Trim(eUserName.Text);
    lo.Password := eLoginPassword.Text;
    lo.SecureLogin := cbSecurityLogin.Checked;
    AddRecord(HOSTID_ROOT, ID_RUNTIMEACCOUNTTABLE, lo);
    EnableCtrls(False);
    ModalResult := mrOK;
  end;
end;

procedure TfrmLoginForm.DoProcMsg(msg: TMsg);
var
  lc: TLoginConfig;
begin
  case msg.MsgID of
    MESID_AAA_LOGINRESPONSE:
      if msg.Error = ERRCODE_NOERROR then
      begin
        lc := TLoginConfig(NewConfigObj(ID_CLIENTLOGIN, '', TLoginConfig));
        lc.LoginUser := Trim(eUserName.Text);
        lc.Password := Trim(eLoginPassword.Text);
        ModalResult := mrOK;
      end
      else
        ShowMessage(Format('登录失败：%s', [ErrCodeToStr(msg.Error)]));
  end;
end;

procedure TfrmLoginForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmLoginForm.FormResize(Sender: TObject);
begin
  inherited;
  GroupBoxLogin.Left := (ClientWidth - GroupBoxLogin.Width) div 2;
  GroupBoxLogin.Top := (ClientHeight - GroupBoxLogin.Height) div 2;
end;

procedure TfrmLoginForm.ReturnPressed(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    if eUserName.Text = '' then
    begin
      eUserName.SetFocus;
      Exit;
    end;
    if eLoginPassword.Text = '' then
    begin
      eLoginPassword.SetFocus;
      Exit;
    end;
    btnLoginClick(btnLogin);
  end;
end;

procedure TfrmLoginForm.ShowLoginResponse(r: Longword);
begin
  ShowErrorMsg(ErrCodeToStr(r), []);
  EnableCtrls(True);
end;

procedure TfrmLoginForm.ShowMessage(S: string);
begin
  LabelMessage.Caption := S;
end;

procedure TfrmLoginForm.FuncStart;
var
  lc: TLoginConfig;
begin
  inherited;
  lc := TLoginConfig(NewConfigObj(ID_CLIENTLOGIN, '', TLoginConfig));
  eUserName.Text := lc.LoginUser;
  eLoginPassword.Text := lc.Password;
  LabelMessage.Caption := '';
  cbSecurityLogin.Checked := lc.SecurityLogin;
  eUserName.OnKeyPress := ReturnPressed;
  eLoginPassword.OnKeyPress := ReturnPressed;
{$IFDEF DEBUG}
  eUserName.Text := 'Root';
  eLoginPassword.Text := '44444444';
{$ENDIF}
end;

procedure TfrmLoginForm.FuncStop;
begin
  inherited;
end;

{ TLoginConfig }

class function TLoginConfig.ClassID: Longword;
begin
  Result := CLASSID_USERCONFIG_LOGINCONFIG;
end;

procedure TLoginConfig.DoAssign(Source: TSerialObj);
var
  src: TLoginConfig absolute Source;
begin
  inherited;
  FLoginUser := src.FLoginUser;
  FPassword := src.FPassword;
  FSecurityLogin := src.FSecurityLogin;
end;

procedure TLoginConfig.DoClone(Target: TSerialObj);
var
  tgt: TLoginConfig absolute Target;
begin
  inherited;
  tgt.FLoginUser := FLoginUser;
  tgt.FPassword := FPassword;
  tgt.FSecurityLogin := FSecurityLogin;
end;

procedure TLoginConfig.DoReadFromPack(PropertyIdx, Len: Longword; Buf: TIOCPDataCollecter);
begin
  case PropertyIdx of
    1:
      Buf.ReadBuf(FSecurityLogin, Len);
    3:
      ReadCommonStringFromPack(Buf, FLoginUser, Len);
    4:
      ReadCommonStringFromPack(Buf, FPassword, Len);
  else
    inherited;
  end;
end;

procedure TLoginConfig.DoWritePropertyToPack(dp: TIOCPDataCollecter);
begin
  inherited;
  WritePropertyToPack(dp, 1, SizeOf(FSecurityLogin), FSecurityLogin);
  WriteCommonStringToPack(dp, 3, FLoginUser);
  WriteCommonStringToPack(dp, 4, FPassword);
end;

procedure TLoginConfig.Return;
begin
  inherited;

end;

procedure TLoginConfig.SetLoginUser(const Value: string);
begin
  if FLoginUser <> Value then
  begin
    FLoginUser := Value;
    DoModifyed;
  end;
end;

procedure TLoginConfig.SetPassword(const Value: string);
begin
  if FPassword <> Value then
  begin
    FPassword := Value;
    DoModifyed;
  end;
end;

procedure TLoginConfig.SetSecurityLogin(const Value: Bool);
begin
  if FSecurityLogin <> Value then
  begin
    FSecurityLogin := Value;
    DoModifyed;
  end;
end;

initialization

ObjPool.RegisterObjClass(TLoginConfig);

end.
